HPAVC/HPAVC CD-ROM.iso/DEARC31.ARJ/DEARCIO.PAS

Pascal/Delphi Source File | 1988-07-26 | 5KB | 262 lines

(**
 *
 *  Module:       dearcio.pas
 *  Description:  DEARC input/output routines
 *
 *  Revision History:
 *     7-26-88 : unitized for turbo 4.0
 *
**)

unit dearcio;

interface
uses
  dos,
  dearcglb,
  dearcabt;

  procedure open_arc;
  procedure open_ext;
  procedure close_arc;
  procedure close_ext(var hdr : heads);
  procedure fseek(offset : longint; base : integer);
  procedure put_ext(c : byte);
  function get_arc : byte;
  procedure fread(var buf; reclen : integer);

implementation


(**
 *
 *  Name:         procedure Read_Block
 *  Description:  read a block from the archive file
 *  Parameters:   none
 *
**)
procedure Read_Block;
var
  res : word;
begin
  if EOF(arcfile) then
    endfile := TRUE
  else
    BlockRead(arcfile, arcbuf, BLOCKSIZE, res);

  arcptr := 1
end; (* proc read_block *)


(**
 *
 *  Name:         procedure Write_Block
 *  Description:  write a block to the extracted file
 *  Parameters:   none
 *
**)
procedure Write_Block;
begin
  BlockWrite(extfile, extbuf, extptr);
  extptr := 1
end; (* proc write_block *)


(**
 *
 *  Name:         function get_arc : byte
 *  Description:  read 1 character from the archive file
 *  Parameters:   none
 *  Returns:      character read
 *
**)
function get_arc : byte;
begin
  if endfile then
    get_arc := 0
  else
    begin
      get_arc := arcbuf[arcptr];
      if arcptr = BLOCKSIZE then
        Read_Block
      else
        arcptr := arcptr + 1
    end
end; (* func get_arc *)


(**
 *
 *  Name:         procedure put_ext
 *  Description:  write 1 character to the extracted file
 *  Parameters:   value -
 *                  c : byte - character to write
 *
**)
procedure put_ext(c : byte);
begin
  extbuf[extptr] := c;
  if extptr = BLOCKSIZE then
    Write_Block
  else
    extptr := extptr + 1
end; (* proc put_ext *)


(**
 *
 *  Name:         procedure open_arc
 *  Description:  open the archive file for input processing
 *  Parameters:   none
 *
**)
procedure open_arc;
begin
  {$I-}
    assign(arcfile, arcname);
  {$I+}
  if (ioresult <> 0) then
    abort('Cannot open archive file.');

  {$I-}
    reset(arcfile, 1);
  {$I+}
  if (ioresult <> 0) then
    abort('Cannot open archive file.');

  endfile := FALSE;
  Read_Block
end; (* proc open_arc *)


(**
 *
 *  Name:         procedure open_ext
 *  Description:  open the extracted file for writing
 *  Parameters:   none
 *
**)
procedure open_ext;
begin
  {$I-}
    assign(extfile, extname);
  {$I+}
  if (ioresult <> 0) then
    abort('Cannot open extract file.');

  {$I-}
    rewrite(extfile, 1);
  {$I+}
  if (ioresult <> 0) then
    abort('Cannot open extract file.');

  extptr := 1;
end; (* proc open_ext *)


(**
 *
 *  Name:         procedure close_arc
 *  Description:  close the archive file
 *  Parameters:   none
 *
**)
procedure close_arc;
begin
  close(arcfile)
end; (* proc close_arc *)


(**
 *
 *  Name:         procedure close_ext
 *  Description:  close the extracted file
 *  Parameters:   none
 *
**)
procedure close_ext(var hdr : heads);
var
  dt     : longint;
  regs   : registers;
  handle : word;
begin
  extptr := extptr - 1;

  if (extptr <> 0) then
    Write_Block;

  close(extfile);


  (*
   *  pbr  - 7-26-88 : added date stamping
   *)
  regs.ax := $3D00;                   (* open file *)
  regs.ds := seg(hdr);
  regs.dx := ofs(hdr.name);
  MsDos(regs);

  handle := regs.ax;

  regs.ax := $5701;                   (* set date/time *)
  regs.bx := handle;
  regs.cx := hdr.time;
  regs.dx := hdr.date;
  MsDos(regs);

  regs.ah := $3E;                     (* close file *)
  regs.bx := handle;
  MsDos(regs);
end; (* proc close_ext *)


(**
 *
 *  Name:         procedure fseek
 *  Description:  re-position the current pointer in the archive file
 *  Parameters:   value -
 *                  offset : longint - offset to position to
 *                  base   : integer - position from:
 *                             0 : beginning of file
 *                             1 : current position
 *                             2 : end-of-file
 *
**)
procedure fseek(offset : longint; base : integer);
var
  b           : longint;
begin
  case base of
    0 : b := offset;
    1 : b := offset + FilePos(arcfile) - BLOCKSIZE + arcptr - 1;
    2 : b := offset + FileSize(arcfile);
    else
      abort('Invalid parameters to fseek')
  end;

  seek(arcfile, b);
  Read_Block;
end; (* proc fseek *)


(**
 *
 *  Name:         procedure fread
 *  Description:  read a record from the archive file
 *  Parameters:   var -
 *                  buf - buffer for read-in data
 *                value -
 *                  reclen : integer - items to read
 *
**)
procedure fread(var buf; reclen : integer);
var i : integer;
    b : array [1..MaxInt] of byte absolute buf;
begin
  for i := 1 to reclen do
    b[i] := get_arc
end; (* proc fread *)

end.